00100	C***** AIDS IN EXTRACTING PARTS FROM SCORES AND DOES AUTOMATIC PAGE LAYOUT. 
00200	C***************************** THERE ARE STILL SEVERAL BUGS IN THIS PROG.
00300	C***************************** TRANSPOSE-ONLY IS NOT FULLY TESTED.
00400	C*********** TRANSPOSITION OF 'F' PARTS IN BASS CLEF HAS SOME PROBLEMS.
00500	C***************************** ETC., ETC.    8/78
00600	
00700	C SEE PAGE.CMD FOR LOADING INSTRUCTIONS
00800	C **** SUBROUTINE LIST *****
00900	C PAGE:  READX
01000	C RESPC:
01100	C RESTP:
01200	C WRTPAG: 
01300	C PGSUB: FILOUT(NAMQ,NPG), FILEIN, STAVES
01400	C TRONLY: 
01500	C TRNSP: TRNSP, RVRS
01600	C PTMOVX: PTMOVE, TURN
01700	C FNDTRN: MNMX, FNDTRN, BRJUGL, GET
01800	C PFAIL: LOOKF,LOOKX,LOOK,SHFTQ,SORT2,NORH,FNDEND,MINMAX,RLOOP,BLTEM,IFIX,FLOAT
01900	C	 GETPTS,MOVIT,EXTEN,DBAR,QRN,SORT,SHIFT,SHFT1,SHFT0,PSHFT,ADRST,STAFF
02000	C        RIGHT,RESTS,EXCHG,EXCH,SHRNK,EXPND,CLFNUM,SLRV,CLEFN,MMNN,CODEN,ZERO 
02100	C EXT:   PUTEXT,EXTOUT,GETEXT,EXTIN,FINEXT
02200	
02300		COMMON/STF/RSTFAC(0/7),RSTJ2 /POSI/STFF(0/7),JJ2,JPQ
02400		1 /IPG/IPG,JPG,BRACK(0/7),RSTNUM(8),RPSZ(8),RHGT(8),
02500		1 RCLEF(0/7) /RSIG/RSIG(0/7) /IVV/NRD(200)
02600		COMMON RS,JA,REST,J2,RQ(18),JX,PR,LX,RDIS
02700	C  ORDER OF COMMON BLOCKS **MUST** STAY AS IS!
02800		COMMON/XRN/RN(3500) /SF/KL,RT,KP,STFSZ,NAMX,EXT
02900		1 /PTR/KWDS(350)/LLL/LLL,LL,I,IX,XSIG/XXX/LK,LP,JY /JN/J,N
03000	C  INCREASE DIMENSION OF KWDS (KPN & Q) FOR VERY FULL PAGES.
03100	      DIMENSION MM(1500),NN(1500),BARS(509),STFNM(0/7),KSAVE(30),
03200		1 RMETER(0/7),RCL(0/7),NUMS(30),PGTRN(500),SAVES(470),U(1)
03300	C KSAVE AND SAVES ARE TO SAVE REHEARSAL NUMS, ETC. -- LIMIT=30
03400		COMMON /PX/KPN(450) /Q/Q(4000) /KBAR/KBAR(1027) /IRST/IRST
03500	 	1 /RCLF/KK,CLEF,KW,ITEM,RSTAFF,SN,YN,RNAM,RNAM2,RNAM3
03600		1 /RSP/KNM(100) /ENDL/ENDLN,KQ,NAME,NMPG,SPCNT,LASTNM
03700		1 /JWDS/JWDS(300),RRN(3000)
03800	C  JWDS IS EQUIVALENCED IN PTMOVX.F4 AND RESTP.F4
03900		DATA FIB/.7/,RSPC/25./,PGNUM/1.6/,RNMHT/16.0/,RNMSZ/1.0/
04000		1 ,RLTRSZ/1.0/,SPCPG/2.7/
04100		EQUIVALENCE (RQ(2),R4),(R5,RQ(3)),(R6,RQ(4)),(R7,RQ(5))
04200		1,(MM,RN),(NN,RN(1501)),(KS,RS),(BARS,KBAR(4)),(JRSTF,RSTJ2)
04300		1,(R8,RQ(6)),(R9,RQ(7)),(RQ(10),XLFT),(KBR,KBAR),(T,KBAR(2))
04400		1,(STFNM,KBAR(508)),(NUM1,NUMS,KPN),(PGTRN(1),KBAR(5 16))
04500		1,(SAVES,Q(3001)),(KSAVE,Q(3475)),(U,KBAR(1026))
04600	C  HANDLES 503 PAGES AND PAGE-TURN INFO. IN KBAR AND PGTRN
04700	C  RQ(2) IS R4, RQ(3) IS R5 ETC.  STAFF NAMES START AT KBAR(508)=STF(0)
04800	
04900		RN(2)=0
05000		EXT='MS'
05100		IRST=0
05200	C IRST IS USED IN SUBROUTINE RESTP
05300		IPG=0
05400		KBR=0
05500		NMPG='PAGEA'
05600		JPG=0
05700		JRD=1
05800		ENDLN=0
05900		SAVSIZ=0
06000		ISN=0
06100		NCNT=10000
06200		IFOUND=0
06300	
06400		TYPE 1000   
06500		ACCEPT 2000,NAMX
06600		IF(NAMX.EQ.0)CALL PT2
06700		IF(NAMX.EQ.3)CALL TRONLY
06800		NPG=NAMX-2
06900		TYPE 3300
07000		IF(NPG.GE.0)GO TO 3000
07100	CC	IF(NPG.GE.0)TYPE 3
07200		ACCEPT 2,KS,NTYPE
07300	C  TYPE -1 AFTER NAME(I.E.5 SPACES) TO PRINT INST. NAMES AS READ.
07400	CC	NAMZ=KS
07500		JNM=1
07600	
07700		CALL LO2UP(KS)
07800	143	CALL IFILE(1,KS)
07900		READ(1,2)K
08000	CC843	READ(1,2)K
08100		IF(K.NE.'COMME')GO TO 543
08200	743	READ(1,643),K,K,K
08300	C  READ ET DIRECTORY !∃∀ βλπα∀πεβα!ββX!
08400		IF(K.NE.';')GO TO 743
08500		READ(1,2)K
08600		GO TO 843
08700	C  FIRST LINE MUST BE EXTENSION NAME
08800	643	FORMAT(3A1)
08900	2	FORMAT(A5,30I)
09000	CC3	FORMAT(' TYPE FILE NAME.EXT -- '$)
09100	3300	FORMAT(' TYPE FILE NAME -- '$)
09200	1000	FORMAT(' 1=PARTS, 2=PAGE LAYOUT, 3=TRNSP ONLY, <CR>=OLD  '$)
09300	2000	FORMAT(I)
09400	CC543	READ(1,2,END=343),KNM(JNM),(KPN(K),K=1,30)
09500	543	CALL IFILE(1,KS)
09600	843	CALL READX(1,KNM(JNM),EXT,KEND,NUMS)
09700		IF(KEND)GO TO 343
09800		JNM=JNM+1
09900		DO 434 K=1,30
10000		J=KPN(K)
10100		JPG=JPG+1
10200		NRD(JPG)=J
10300	C  BE CAREFUL ABOUT RUNNING OVER NRD ARRAY (100)-- ZEROS ARE INSERTED***********
10400	434	IF(J.EQ.0)GO TO 843
10500		GO TO 843
10600	CC3000	CALL NAMEXT     
10700	3000	CALL READX(5,NAMX,EXT,KEND,NUMS)
10800		KNM(1)=NAMX
10900		GO TO 4000
11000	343	KNM(JNM)=-1
11100		NXX=NRD(1)
11200	C NXX COULD BE EQUIV. TO NRD(1)!!
11300	4000	NAMZ=KNM(1)
11400		IF(NPG.GE.0.AND.NUM1.GT.0)NCNT=NUM1
11500	C TYPE A # AFTER FILE NAME TO SET # OF FILES TO BE READ.
11600		DO 911 K=0,7
11700		RCLEF(K)=99
11800		RCL(K)=99
11900		RMETER(K)=99
12000	C  INITS STUFF FOR PAGE LAYOUT
12100		BRACK(K)=0
12200	911	RSIG(K)=99
12300		
12400	744	XSIG=FIB
12500		QSIG=FIB
12600		CLEF=-1
12700		XMTR=FIB
12800		XLFT=0
12900		JPG=0
13000		YCLEF=2.
13100		YSIG=2.
13200		YMTR=2.
13300		RSTAFF=0
13400		RM=0
13500		JNM=1
13600	CZ1344	JNM=1
13700	
13800	1344	IF(NCNT.EQ.0)GO TO 1212
13900	C NCNT IS INPUT FILE COUNTER.
14000		NCNT=NCNT-1
14100		ZLFT=.5
14200		KQ=0
14300		IF(NPG.EQ.0)JRD=0
14400		LLL=1
14500		LK=1
14600	86	FORMAT(1XA5)
14700	186	FORMAT(1XA5,'.',A3)
14800	
14900	83	NAME=KNM(JNM)
15000	CZ	JNM=JNM+1
15100		IF(NAME.EQ.-1)GO TO 1212
15200	CC	JRD=JRD+1
15300	CXCX	NXX=NRD(JRD+1)
15400	CZ	NXX=NRD(JRD)
15500	C?????????????	IF(KBR.EQ.0)GO TO 284
15600		JZ=-1
15700	10	IF(LOOKX(NAME,EXT))GO TO 284
15800	CZ100	IF(JZ)GO TO 344
15900	C  FOUND NO MORE TO READ
16000	344	NAME=NAMZ+256
16100	C UPDATE 4TH CHAR.  (E.G. AAAAA TO AAABA)
16200		NAMZ=NAME
16300		KNM(JNM)=NAME
16400		IF(LOOKX(NAME,EXT))GO TO 284 
16500	C NOW ALL DONE WITH INPUT, START OUTPUT
16600	1212	CALL PUTEXT('BARS','PAG')
16700		RSTJ2=SAVSIZ
16800		DO 1213 K=0,75
16900	1213	U(K)=RSTFAC(K)
17000	C SAVE VARIOUS THINGS ON END OF KBAR ARRAY FOR USE IN OUTPUT SECTION.
17100		CALL EXTOUT(KBAR,1100)
17200	CC	CALL EXTOUT(RSTFAC,128)
17300		CALL FINEXT
17400	C K (NUM OF BARS - UP TO 511) IS FIRST LOC OF KBAR.
17500		CALL PT2(KPN,Q,KWDS,RN)
17600	
17700	284	JZ=0
17800		SN=0
17900		IF(NPG)SN=200
18000		SNMTR=SN
18100		IF(RM.NE.0)GO TO 277
18200		RM=-1
18300	4	FORMAT(' TYPE INST NAME  '$)
18400		IF(NPG.GE.0)GO TO 277     
18500		TYPE 4
18600		ACCEPT 2,RNAM,K
18700		CALL LO2UP(RNAM)
18800		RNAM2=-1
18900		RNAM3=-1
19000		RNAM4=-1
19100		IF(K.EQ.0)GO TO 277
19200		TYPE 177
19300		ACCEPT 2,RNAM2,K
19400		CALL LO2UP(RNAM2)
19500		IF(K.EQ.0)GO TO 277
19600	C  TYPE NUM AFTER NAME TO ENTER UP TO 4 NAMES.
19700		TYPE 177
19800		ACCEPT 2,RNAM3
19900		CALL LO2UP(RNAM3)
20000		TYPE 177
20100		ACCEPT 2,RNAM4
20200		CALL LO2UP(RNAM4)
20300	177	FORMAT(' OTHER INST NAME   ',$)
20400	
20500	
20600	277	TYPE 186,NAME,EXT
20700	C*** 	CALL GETEXT(NAME,EXT)
20800	C*** C  LP IS START OF RN ARRAY THIS TIME
20900	C*** 	CALL EXTIN(RSTFAC,20)
21000	C*** 	CALL EXTIN(KWDS,JJ2)
21100	C*** 	CALL EXTIN(RN,JPQ)
21200		CALL INMUS(NAME,EXT,RN,KWDS,RSTFAC)
21300	C NEW SAVE FORMAT
21400		IF(JRSTF.LT.10000)RSTJ2=1.0
21500	C X!Z+*↑: WHERE IS THE BUG THAT PUTS AN INTEGER INTO RSTJ2????
21600	CZ	IF(SAVSIZ.EQ.0)SAVSIZ=RSTJ2
21700		IPG=NPG
21800	C  IPG MUST BE RESET EACH TIME BECAUSE READIN WIPES IT OUT.
21900	
22000		CALL RLOOP(Q,RN,JPQ)
22100		ITEM=JJ2-2
22200	
22300	1211	R=RN(KWDS(1)+2)
22400		K=2
22500		LS=1
22600		J=0
22700	C  SORTS NOTES AND RHYTH ONLY
22800	1111	KX=KWDS(K)
22900		RA=RN(KX+2)
23000		IF(RA.GE.R)GO TO 1011
23100		CALL EXCH(KWDS(K),KWDS(LS))
23200		J=-1
23300	1011	R=RA
23400	2611	LS=K
23500		K=K+1
23600		IF(K.LE.ITEM)GO TO 1111
23700		IF(J)GO TO 1211
23800	C NOW ALL SORTED  (BY  STAFF)
23900		J=1
24000		KW=1
24100	
24200		DO 1311 K=1,ITEM
24300		LS=KWDS(K)
24400		IF(RN(LS+1).GT.2)GO TO 2711
24500		RN(LS+3)=RN(LS+3)-.001
24600	C  MOVE ALL NOTES AND RESTS SLIGHTLY TO LEFT. (FOR SORTER)
24700	2711	M=RN(LS)+3
24800		CALL RLOOP(Q(J),RN(LS),M)
24900		J=J+M
25000		KPN(K)=KW
25100	1311	KW=KW+M  
25200	
25300		KPN(ITEM+1)=KW
25400	CC	DO 1511 K=1,ITEM+1
25500	CC1511	KWDS(K)=KPN(K)
25600	CC	DO 1611 K=1,JPQ
25700	CC1611	RN(K)=Q(K)
25800		CALL BLTEM
25900	C  BLTEM BLTS ARRAYS KPN AND Q INTO KWDS AND RN
26000	
26100		DO 18 K=1,JPQ
26200	18	Q(K)=0
26300	C ZERO IT FOR FUTURE SAFETY
26400	
26500		JCUE=0
26600		RLFT=10000
26700	811	DO 577 K=1,ITEM
26800		R=CODEN(KWDS,K,RN,J)
26900		IF(R.GT.2)GO TO 809
27000		IF(RLFT.GT.RN(J+3))RLFT=RN(J+3)
27100	C RLFT IS LEFT-MOST NOTE OR REST.  USED FOR DISCARDING ENTERING SLURS.
27200		GO TO 577
27300	809	IF(R.LT.4)GO TO 577
27400		RWD=RN(J)
27500	C RWD IS WDCNT OF EACH ITEM
27600		JS=RN(J+2)
27700		IF(IPG.LT.0)GO TO 111
27800	C IPG=-1 = EXTRACTING PARTS, =0  = PAGE LAYOUT.
27900		IF(R.NE.8)GO TO 211
28000		STFNM(JS)=0
28100		IF(RWD.GE.7)STFNM(JS)=RN(J+9)
28200	C SAVES STAFF IDENT. NAME
28300	1811	IF(ENDLN.NE.0)GO TO 577
28400		JPG=JPG+1
28500		LS=JS+1
28600		RSTNUM(LS)=JS
28700		RHGT(LS)=0
28800	 	IF(RWD.GE.2)RHGT(LS)=RN(J+4)
28900		RPSZ(LS)=RSTFAC(JS)
29000		IF(SAVSIZ.EQ.0)SAVSIZ=RPSZ(LS)
29100		IF(R5.EQ.0)SPCNT=SPCPG*RPSZ(LS)
29200	211	IF(R.NE.4)GO TO 577
29300		IF(RN(J+3).LT.RLFT)GO TO 311
29400	CC	IF(RN(J+3).LT.ZLFT)GO TO 311
29500	C ASSUMES NOTE OR REST HAS ALREADY BEEN SEEN. (ZLFT=P3+.5)
29600		IF(RN(J+2).NE.0)RN(J+1)=44
29700	CC	IF(RN(J+2).EQ.0)GO TO 577
29800	CC511	RN(J+1)=44
29900	C  BARS NOT ON STAFF ZERO NOW HAVE CODE NUM. 44
30000		GO TO 577
30100	311	IF(IPG.LT.0)GO TO 577
30200		IF(ENDLN.NE.0)GO TO 577
30300		IF(RWD.GE.5)BRACK(JS)=RN(J+7)+RN(J+4)*100.
30400	C  SAVE 'BRACKET' INFO (P7=3,4 OR 5) - CAN FIND WRONG THING!!
30500		GO TO 577
30600	
30700	111	IF(R.NE.8)GO TO 112
30800		IF(RWD.LT.7)GO TO 577
30900	C  NO NAME ON THIS STAFF - SO JUMP
31000		IF(RN(J+7).NE.0)GO TO 577
31100	C  SKIPS INVISIBLE STAVES.
31200		XLFT=RN(J+3) 
31300	C LEFT LIMIT OF STAFF
31400		R9=RN(J+9)
31500		IF(NTYPE.LT.0)TYPE 86,R9
31600		IF(R9.EQ.RNAM)GO TO 977
31700		IF(RNAM2.EQ.R9)GO TO 977
31800		IF(RNAM3.EQ.R9)GO TO 977
31900		IF(RNAM4.NE.R9)GO TO 577
32000	977	TYPE 1577,R9,NAME
32100		IF(SN.NE.200.)PAUSE ' **** SAME NAME FOUND AGAIN ****'
32200		I=JS+RSTAFF
32300		SN=I
32400		SNMTR=SN
32500		IFOUND=-1
32600	C FLAG TO SAVE RN AND KWDS ARRAYS
32700		RPSZ(1)=RSTFAC(JS)
32800		IF(SAVSIZ.EQ.0)SAVSIZ=RPSZ(1)
32900	C  SO IT WON'T LOOK ON MORE STAVES IN OTHER FILES.
33000	CZ	IF(NXX.GT.1)NXX=-NXX
33100	C THIS TAKEN OUT 3/7/80 BECAUSE DIDN'T FIND WORDS IN LOWER FILES.
33200		JCUE=-1
33300	CCC	IF(IPG.LT.0)TYPE 1577,R9,NAME
33400	C WE ONLY GET WHEN EXTRACTING PARTS.
33500		GO TO 577
33600	1577	FORMAT(1XA5,' FOUND IN ',A5)
33700	CXXX	GO TO 477
33800	112	IF(IPG.GE.0)GO TO 577
33900		IF(R.NE.16)GO TO 113
34000		IF(RN(J+5).LT.100)GO TO 577
34100		GO TO 1113
34200	113	IF(R.NE.10)GO TO 577
34300	C  SKIPS PAGE NUMS. (I.E. P7 > 2)
34400		IF(RN(J+6).LT.100)GO TO 577
34500	C SAVE NUMBER IF SIZE FACTOR(R6) IS +100 (JUST LIKE CODE 16)
34600	C????******ALL THIS TO 800-1 CAN NOW BE TAKEN OUT.  USE P6+100 FOR REHRSL. #S.
34700		RN(J+4)=RNMHT
34800		RN(J+6)=RNMSZ
34900	C  THE ABOVE SET HEIGHT AND SIZE OF REHEARSAL NUMS.
35000	1113	RN(J+2)=0
35100	C PARTS ARE ALWAYS ON STAFF 0
35200	CX	JS=J
35300		JJK=RWD+2+LK
35400	CX	DO 1112 JJJ=LK,JJK
35500	CX    	SAVES(JJJ)=RN(JS)
35600	CX1112	JS=JS+1
35700		I=JJK-LK+1
35800		CALL RLOOP(SAVES(LK),RN(J),I)
35900	C PUTS RN INTO SAVES
36000		LK=JJK+1
36100		RN(J+2)=10.
36200		LLL=LLL+1
36300		KSAVE(LLL)=LK
36400	577	CONTINUE
36500	C  DIDN'T FIND USEFUL INFO SO SKIP THIS FILE
36600	CX	IF(JCUE)GO TO 477
36700	CCC	IF(IPG)TYPE 1577,RNAM,NAME
36800	477	I=JPQ-2
36900	C READS AND WRITES 1 EXTRA WORD
37000		IF(IPG.EQ.0)GO TO 13
37100	
37200		IF(IFOUND.GE.0)GO TO 877
37300		IFOUND=-IFOUND
37400		JTEM=ITEM+1
37500		DO 1877 K=1,JTEM
37600	1877	JWDS(K)=KWDS(K)
37700		DO 2877 K=1,KWDS(JTEM)
37800	2877	RRN(K)=RN(K)
37900	C NOW DATA FOR THIS INST. IS SAVED.
38000	
38100	CZ	IF(NXX.GT.0)GO TO 877
38200	C NEXT FOR PARTS ONLY.  TO SKIP A FILE (OR MORE)
38300	CZ	NAME=NAME-2*(NXX+1)
38400	CZ	NXX=1
38500	877	NXX=NXX-1
38600		KNM(JNM)=NAME
38700		NAME=NAME+2
38800		IF(NXX.NE.0)GO TO 277
38900		JRD=JRD+1
39000		NXX=NRD(JRD)
39100		IF(NXX.NE.0)GO TO 44
39200		JNM=JNM+1
39300		NAMZ=KNM(JNM)
39400		KNM(JNM)=NAMZ-2
39500	C KNM GETS BACK +2 AT RETURN FROM RESPC.
39600		JRD=JRD+1
39700		NXX=NRD(JRD)
39800	CZ	NAME=0
39900	CZ	NAMZ=0
40000	44	RSTAFF=0
40100	13	YN=0
40200		IF(SN.NE.200)GO TO 8
40300		YN=-1
40400		IF(YCLEF.GT.1)YCLEF=-1
40500		IF(YSIG.GT.1)YSIG=-1
40600		IF(YMTR.GT.1)YMTR=-1
40700	
40800	8	ZLFT=XLFT+.5
40900		RNUM=PGNUM
41000	C  SIZE FACTOR FOR PAGE NUMBER FINDER (MAYBE).
41050		QLFT=RLFT
41075	C SAVE IN QLFT FOR 1ST BAR OF LINE CHECK.
41100		RLFT=RLFT-3
41200	C TO CATCH 1ST SLURS.
41300		JCUE=0
41400	
41500	C****	IF(LK.EQ.1)GO TO 2112
41600		IF(LK.EQ.1)GO TO 2113
41700	CX	DO 3112 K=1,LK    
41800	CX3112	Q(K)=SAVES(K)
41900		CALL RLOOP(Q,SAVES,LK)
42000	C PUTS SAVED THINGS INTO Q ARRAY AND POINTER ARRAY (KPN)
42100	CX	DO 4112 K=2,LLL
42200	CX4112	KPN(K)=KSAVE(K)
42300		CALL RLOOP(KPN,KSAVE,LLL)
42400		KPN(1)=1
42500	2113	IF(IPG.EQ.0)GO TO 2112
42600		IF(IFOUND.EQ.0)GO TO 2112
42700		IFOUND=0
42800		DO 183 K=1,JTEM
42900	183	KWDS(K)=JWDS(K)
43000		DO 283 K=1,KWDS(JTEM)
43100	283	RN(K)=RRN(K)
43200		ITEM=JTEM-1
43300	C NOW GOT BACK DATA FOR SINGLE INST.
43400	
43500	C THIS SECTION COLLECTS ALL ITEMS TO USED LATER(NOT EVERYTHING IF 'PARTS')
43600	2112	DO 6 K=1,ITEM
43700		R5=-1
43800		R=CODEN(KWDS,K,RN,J)
43900		IF(R.EQ.0)GO TO 6
44000	C  DUPLICATE BARS WERE CHANGED TO CODE 0
44100		RWD=RN(J)
44200	C RWD IS WDCNT OF EACH ITEM
44300	800	IF(R.NE.4)GO TO 80
44400		IF(RN(J+4).GE.1000)GO TO 801
44500	C FINDS DBL BARS OF ALL SORTS
44600		IF(RWD.GT.2)GO TO 182
44700	C  FOUND A BAR LINE
44800	CC801	IF(RN(J+3).LT.ZLFT)GO TO 6
44900	801	IF(RN(J+3).LT.QLFT)GO TO 6
44920	CC801	IF(RN(J+3).LT.RLFT)GO TO 6
45000	C DROPS BAR LINE TO LEFT OF FIRST NOTE OR REST.
45100		IF(IPG.EQ.0)GO TO 382 
45200		IF(RWD.LT.2)GO TO 382
45300		LL=RN(J+4)/100.
45400		RR=100*LL+1.0
45500		RN(J+4)=RR
45600	C THIS PRESERVES DOUBLE BARS OF ALL SORTS.
45700	CCC	IF(RN(J+2).NE.0)GO TO 182
45800	C  KEEP BAR LINES ON STAVES >0 BUT DON'T COUNT THEM.
45900	382	CALL DBAR(K,ITEM,J)
46000		IF(YN.EQ.0)GO TO 810
46100		CALL ADRST(KPN,RR)
46200		GO TO 6
46300	182	RN(J+1)=44
46400	C  CHANGES CODE NUM 
46500		IF(IPG.EQ.0)GO TO 482
46600		IF(RN(J+5).EQ.150)RN(J+2)=SN
46700	C P5=150=PUT CRESC-DECRESC. IN ALL PARTS (WHEN IN PARTS MODE [IPG=-1])
46800	482	IF(RWD.LT.5)GO TO 80
46900		IF(RN(J+7).GE.3)GO TO 6
47000	C  SKIP HEAVY BRACKETS.
47100		IF(RWD.LT.4)GO TO 80
47200		A=RN(J+6)
47300		IF(A.EQ.0)GO TO 80
47400		IF(A.GE.199)RN(J+6)=200
47500	
47600	80	IF(R.NE.16)GO TO 180
47700		IF(RWD.LT.8)GO TO 280
47800		IF(RN(J+10).EQ.1)RN(J+3)=RN(KWDS(K-1)+3)
47900	C PUT CONTINUATION OF TEXT IN SAME POS. AS 1ST UNIT OF TEXT.
48000	280	IF(IPG.EQ.0)GO TO 180
48100		IF(RN(J+5).GE.100)RN(J+2)=SN
48200	C CATCHES WANTED TEXT ON OTHER LINES.  (P5>100)
48300	CXXX 	IF(RN(J+5).GT.RLTRSZ)RN(J+5)=RLTRSZ
48400	C  LIMITS SIZE OF LETTERS.  ADJUST RLTRSZ TO SUIT. (SET AT 1.0 NOW)
48500	
48600	180	RSN=RN(J+2)
48700		IF(IPG.LT.0)GO TO 2011
48800		ISN=RSN
48900		RSN=SN
49000	C  THE STAFF NUM.
49100	
49200	2011	IF(R.NE.3)GO TO 3801
49300		IF(IPG.LT.0)GO TO 2111
49400		CLEF=RCL(ISN)
49500		GO TO 4801
49600	2111	IF(RN(J+6).LT.100)GO TO 4804
49700		RN(J+2)=SN
49800	C SIZE +100 (R6) IS PUT IN ALL PARTS (FOR P,PP,PPP,MF, ETC.)
49900		GO TO 4803
50000	4804	IF(YCLEF)GO TO 4801
50100		IF(RSN.NE.SN)GO TO 6
50200	4801	RR=CLEFN(RN,J)
50300	C  GET CLEF NUMBER.
50400		IF(RR.EQ.CLEF)GO TO 6
50500	C SKIP DUPLICATE CLEFS.
50600		IF(RR.GT.4)GO TO 4800
50700	C 0=TREB 1=BASS 2=ALTO 3=TENOR 4=PERCUSSION CLEF.
50800		IF(IPG.LT.0)GO TO 17
50900		RCL(ISN)=RR
51000		IF(RCLEF(ISN).EQ.99)RCLEF(ISN)=RR
51100	C  SAVE FIRST CLEF ON EACH STAFF
51200		GO TO 1800
51300	CP16	FORMAT(' CLEF=',F2.0,' --CHANGE TO--',$)
51400	CP	TYPE 16,RR
51500	CP	ACCEPT 5,RR
51600	17 	R5=RR
51700		CLEF=RR
51800		YCLEF=0
51900		GO TO 1800
52000	4800	IF(RSN.NE.SN)GO TO 6
52100	4803	RN(J+1)=33
52200		GO TO 1800
52300	4802	YCLEF=0
52400	C  CATCHES CLEF AFTER FIRST RESTS.
52500		GO TO 6
52600	
52700	3801	IF(R.NE.17)GO TO 3800
52800		RR=RN(J+5)
52900		IF(IPG.GE.0)GO TO 3803
53000		IF(RSN.NE.SN)GO TO 6
53100	C FOR PARTS:  SKIP IF NOT ON RIGHT STAFF.
53200		IF(QSIG.EQ.RR)GO TO 6
53300	C FOR PARTS:  IF SAME KEY SIG. THEN OMIT IT.
53400		QSIG=RR
53500		GO TO 3804
53600	3803	IF(RR.EQ.RSIG(ISN))GO TO 6
53700	C SKIPS DUPL. KEY SIGS. 
53800	C***** WHAT ABOUT CHANGING KEY SIGS?????
53900	CC	YSIG=0
54000	3804	IF(RSIG(ISN).EQ.99)RSIG(ISN)=RR
54100	C SETS UP KSIG ONCE ONLY.
54200		GO TO 1800
54300	
54400	3800	IF(R.EQ.8)GO TO 6
54500	C  OMIT ALL STAVES FOR NOW
54600		IF(R.NE.18.)GO TO 81
54700	CP	IF(IPG)GO TO 2311
54800		XMTR=RMETER(ISN)
54900		GO TO 1801
55000	2311	IF(YMTR)GO TO 1801
55100		IF(SNMTR.EQ.200.)SNMTR=RSN
55200	C  SO IT WON'T REPEAT METERS.
55300	C  CHECK ALL METERS IF LINE HAS NOT THIS INST.
55400		IF(RSN.NE.SNMTR)GO TO 6
55500	1801	RA=TSIG(RN,J)
55600	C  THE TIME SIG.
55700		IF(XMTR.EQ.RA)GO TO 6
55800		XSIG=RA
55900		XMTR=RA
56000		YMTR=0
56100		IF(IPG.LT.0)GO TO 181
56200		RMETER(ISN)=RA
56300		GO TO 1800
56400	181	RR=RN(J+3)
56500		DO 281 LS=1,LLL-1
56600		IF(CODEN(KPN,LS,Q,KW).NE.R)GO TO 281
56700	C LOOK FOR SAME  METER CLOSE TO  SAME POS. (DIF. METER WILL OVERPRINT)
56800		IF(XSIG.NE.TSIG(Q,KW))GO TO 281
56900		IF(ABS(Q(KW+3)-RR).LT.0.5)GO TO 6
57000	281	CONTINUE
57100		GO TO 1800
57200	
57300	81	IF(RSN.NE.SN)GO TO 6
57400	1800	IF(IPG.EQ.0)GO TO 5800
57500		IF(RN(J+3).LT.XLFT)GO TO 6
57600	C OMIT SOME THINGS TO LEFT OF STAFF BEGINNING.
57700		GO TO 6800
57800	5800	IF(R.NE.7)GO TO 282
57900	6800	IF(R.LT.4)GO TO 810
58000		IF(R.EQ.44)GO TO 6801
58100		IF(R.GT.7)GO TO 810
58200	C  NEXT FOR ITEMS WHERE P6 MAY GO PAST 200.
58300		IF(RWD.LT.5)GO TO 810
58400	6801	A=ABS(RN(J+7))
58500		IF(A.LT.2.OR.A.GT.7)GO TO 82
58600	C  CATCHES TRILL WIGGLE OVER END OF LINE.
58700	282	IF(R.NE.5)GO TO 810
58800		IF(RN(J+3).LT.RLFT)GO TO 6
58900	C OMIT ENTERING SLURS.   NEXT CHECKS FOR SLUR OVER END OF LINE
59000	82	IF(RN(J+6).GE.199.)RN(J+6)=200.
59100	C  ****** 200.0 ABOVE IS SUBJECT TO CHANGE!
59200	810	KL=0
59300	CC	IF(R.GT.2)GO TO 1810
59400		IF(R.EQ.1)GO TO 2810
59500		IF(R.NE.2)GO TO 1810
59600		IF(IPG.GE.0)GO TO 2810
59700		IF(RWD.LT.8)GO TO 2810
59800	C NEXT FOR FINDING CUES WHEN IN PARTS MODE.  FINALLY GETS LAST NEEDED POINTER.
59900		IF(RN(J+10).GE.0)JCUE=K
60000	C NEXTS FINDS NOTES AND RESTS WITHOUT RHYTHM (P7 OR P9)
60100	2810	IF(RN(J+3)-PQ.GT.SPCPG)GO TO 1810
60200	C  JUMP IF NOT IN SAME VERT. POS.
60300		IF(RT.NE.R)GO TO 1810
60400	C JUMP IF PREVIOUS ITEM WASN'T THE SAME
60500	CC	IF(RN(J+9).NE.4.0/88.0)GO TO 3810
60600	C JUMP IF NOT A GRACE NOTE
60700	CC	R=0
60800	C R=0 SO THAT GRACE NOTE WILL NEVER BE TOO CLOSE TO REG. NOTE.
60900	CC	GO TO 1810
61000	3810	RS=9-R*2
61100		IF(RWD.GE.RS)GO TO 1810
61200	C JUMP IF WDCNT IS BIG ENOUGH
61300		KL=RS-RWD
61400	C  SEND THE DIFFERENCE TO THE SUBROUTINE AND ADD A RHYTHM (1.0)
61500	1810	IF(IPG.LT.0)RN(J+2)=0
61600	C  ALWAYS SET STAFF NUM TO 0 FOR PARTS.
61700		CALL QRN(J,KPN,K)
61800	C  PUTS NEEDED THINGS INTO Q ARRAY
61900		RT=R
62000		PQ=RN(J+3)
62100	C SAVE THINGS FOR NEXT TIME AROUND LOOP.
62200	6	CONTINUE
62300	
62400		IF(JCUE.NE.0)CALL CUES
62500	
62600	C******↓↓↓↓↓↓ RHYTH RESET ↓↓↓↓↓↓↓↓
62700		CALL SORT(KPN)
62800	C   SORTS Q ARRAY, PUTS IT BACK INTO RN
62900	23	LL=0
63000	C  TO 'MOVE' INSTEAD OF 'JUSTIFY'
63100	CC	J=1
63200	CC223	R=CODEN(KWDS,J,RN,K)
63300	CC	IF(R.LE.3.OR.R.EQ.17.OR.R.EQ.18)GO TO 123
63400	CC	J=J+1
63500	CC	GO TO 223
63600	CC123	R8=ENDLN-RN(K+3)+2
63700	CC	R4=0
63800	CC	R7=0
63900	CC	RS=0
64000	CC	R9=0
64100	CC	R5=10000
64200	C  INSERT??  →→ IF(R8.GT.0)R9=200.
64300	CC33	CALL PTMOVE(RN,KWDS)
64400	C******* IS KQ SUPPOSED TO BE 0!!!!!!!!?????
64500		CALL SHFT0(KQ)
64600	20	CALL RESPC
64700		KNM(JNM)=KNM(JNM)+2
64800	C UPDATE THE FILE NAME
64900		GO TO 1344
65000		END
65100	
65200		SUBROUTINE READX(IDEV,NAME,IEXT,KEND,NUMS)
65300		COMMON /PTR/INP(72)
65400		DIMENSION FORM2(5),FORMT(5),NUMS(30)
65500		DATA FORMT(1)/'('/,FORM2/'A1,','A2,','A3,','A4,','A5,'/
65600		1, FORM3/'30I)'/
65700	1	FORMAT(72A1)
65800	CC	IEXT='MS'
65900	CC	ACCEPT 1,INP
66000		KEND=0
66100	C IDEV=DEVICE NUMBER (1=DSK, 5=TTY)
66200		READ(IDEV,1,END=12)INP
66300		DO 2 K=2,72
66400		IF(INP(K).EQ.' ')GO TO 3
66500	2	IF(INP(K).EQ.'.')GO TO 4
66600	3	FORMT(3)=FORM3
66700		FORMT(4)=' '
66800		FORMT(5)=' '
66900	5	FORMT(2)=FORM2(K-1)
67000		REREAD FORMT,NAME,NUMS
67100		GO TO 10
67200	4	FORMT(3)=FORM2(1)
67300	C  CATCHES DOT
67400		DO 7 N=K+1,72
67500	7	IF(INP(N).EQ.' ')GO TO 8
67600	8	FORMT(4)=FORM2(N-K-1)
67700		FORMT(5)=FORM3
67800		FORMT(2)=FORM2(K-1)
67900		REREAD FORMT,NAME,K,IEXT,NUMS
68000		CALL LO2UP(IEXT)
68100	10	CALL LO2UP(NAME)
68200		RETURN
68300	12	KEND=-1
68400		END
68500	
68600		SUBROUTINE LO2UP(J)
68700	C CONVERTS ALL LOWER CASE TO UPPER CASE.
68800		J=J.AND..NOT.((J/2).AND."201004020100)
68900		END
69000	
69100		FUNCTION TSIG(Q,J)
69200		DIMENSION Q(1)
69300		TSIG=IFIX(Q(J+5)*100.0+Q(J+6)+.5)
69400	C COMBINES METER NUMS.  (2/4 = 204. ETC.)
69500		END